home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp4.arc
/
SENDXMOD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-08-31
|
25KB
|
678 lines
(*----------------------------------------------------------------------*)
(* Send_Xmodem_File --- Upload file using XMODEM *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_Xmodem_File( Use_CRC : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Send_Xmodem_File *)
(* *)
(* Purpose: Uploads file to remote host using XMODEM protocol. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Send_Xmodem_File( Use_CRC ); *)
(* *)
(* Use_CRC --- TRUE to use Cyclic redundancy check version *)
(* of XMODEM; FALSE to use Checksum version. *)
(* *)
(* Remarks: *)
(* *)
(* The file's existence should have been already checked *)
(* prior to calling this routine. *)
(* *)
(* The transmission parameters are automatically set to: *)
(* *)
(* Current baud rate, 8 bits, No parity, 1 stop *)
(* *)
(* and then they are automatically restored to the previous *)
(* values when the transfer is complete. *)
(* *)
(* Calls: KeyPressed *)
(* Async_Send *)
(* Async_Receive *)
(* Compute_Crc *)
(* Draw_Menu_Frame *)
(* Save_Screen *)
(* Restore_Screen *)
(* Async_Open *)
(* *)
(*----------------------------------------------------------------------*)
(* If this threshhold value x number *)
(* of bad blocks > number of good *)
(* blocks, reduce block size to 128 *)
CONST
Bad_Threshhold = 6;
VAR
Xfile_Byte : FILE OF BYTE (* Same as transfer file, file size *);
XFile_Handle : INTEGER (* File handle for file to transfer *);
I : INTEGER (* Loop index *);
Tries : INTEGER (* # of tries sending current sector *);
Checksum : INTEGER (* Sector checksum *);
Crc : INTEGER (* Cyclic redundancy check *);
Ch : INTEGER (* Character received from COM port *);
Sector_Length : INTEGER (* # chars to send *);
Kbd_Ch : CHAR (* Absorbs keyboard characters *);
Send_Errors : INTEGER (* Counts transfer errors *);
Blocks_To_Send: INTEGER (* Number of blocks to send *);
Sector_Count : INTEGER (* Sector count -- no wrap at 255 *);
Transfer_Time : INTEGER (* Transfer time in seconds *);
Starting_Time : INTEGER (* Starting transfer time *);
Trans_Hours : INTEGER (* Transfer time -- hours component *);
Trans_Minutes : INTEGER (* Transfer time -- mins. component *);
Trans_Seconds : INTEGER (* Transfer time -- secs. component *);
S_Hours : STRING[2] (* Hours in character form *);
S_Minutes : STRING[2] (* Minutes in character form *);
S_Seconds : STRING[2] (* Seconds in character form *);
Time_To_Send : REAL (* Time in seconds to transfer file *);
Time_Per_Blk : REAL (* Time in seconds to transfer block *);
Effective_Rate: REAL (* Effective baud rate of transfer *);
Start_Time : REAL (* Starting time of transfer *);
End_Time : REAL (* Ending time of transfer *);
NRead : INTEGER (* Records actually read from file *);
EOF_Xfile : BOOLEAN (* EOF encountered on file to send *);
Tname : STRING[20] (* Transfer type *);
Sector_Size1 : INTEGER (* Sector size + 1 *);
Sector_Size2 : INTEGER (* Sector size + 2 *);
Alt_S_Found : BOOLEAN (* TRUE if alt_s entered *);
Max_Tries : INTEGER (* Max. number of retries *);
R_Sector_Size : REAL (* Sector size as reals *);
Header_Ch : CHAR (* Block header character *);
New_Header_Ch : CHAR (* Revised block header if downshift *);
Bad_Sectors : INTEGER (* Count of bad sectors *);
Good_Sectors : INTEGER (* Count of good sectors *);
ITime : INTEGER (* Counter for wait loops *);
(*----------------------------------------------------------------------*)
(* Update_Xmodem_Send_Display --- Update display of Xmodem sending *)
(*----------------------------------------------------------------------*)
PROCEDURE Update_Xmodem_Send_Display;
BEGIN (* Update_Xmodem_Send_Display *)
GoToXY( 26 , 4 );
WRITE( Sector_Count );
GoToXY( 26 , 5 );
WRITE( Send_Errors );
GoToXY( 26 , 6 );
WRITE( TimeString( Time_To_Send ) );
END (* Update_Xmodem_Send_Display *);
(*----------------------------------------------------------------------*)
(* Display_Send_Error --- Display XMODEM sending error *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Send_Error( Err_Text: AnyStr; Display_Block: BOOLEAN );
BEGIN (* Display_Send_Error *)
GoToXY( 26 , 8 );
WRITE(Err_Text);
IF Display_Block THEN
WRITE( ' at/before block ', MAX( Sector_Count - 1 , 0 ) );
ClrEol;
END (* Display_Send_Error *);
(*----------------------------------------------------------------------*)
(* Check_Keyboard --- Check for keyboard entry *)
(*----------------------------------------------------------------------*)
PROCEDURE Check_Keyboard;
BEGIN (* Check_Keyboard *)
IF KeyPressed THEN
BEGIN
READ( Kbd, Kbd_Ch );
IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
BEGIN
READ( Kbd , Kbd_Ch );
Alt_S_Found := ( ORD( Kbd_Ch ) = Alt_S );
Stop_Send := Stop_Send OR Alt_S_Found;
END;
END;
END (* Check_Keyboard *);
(*----------------------------------------------------------------------*)
(* Xmodem_Wait_For_Ch --- wait 10 seconds for character to appear *)
(*----------------------------------------------------------------------*)
PROCEDURE Xmodem_Wait_For_Ch( VAR Ch: INTEGER );
BEGIN (* Xmodem_Wait_For_Ch *)
ITime := 0;
REPEAT
ITime := ITime + 1;
Async_Receive_With_Timeout( One_Second , Ch );
Check_KeyBoard;
UNTIL ( Ch <> TimeOut ) OR ( ITime >= Ten_Seconds ) OR Stop_Send;
END (* Xmodem_Wait_For_Ch *);
(*----------------------------------------------------------------------*)
(* Send_Xmodem_Block --- send out Xmodem block *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_Xmodem_Block;
VAR
I : INTEGER;
ITime : INTEGER;
BEGIN (* Send_Xmodem_Block *)
(* Reset error count to zero *)
Tries := 0;
REPEAT
(* Send 1st char of block *)
Async_Send( Header_Ch );
(* Send block number and complement *)
Async_Send( CHR( Sector_Number ) );
Async_Send( CHR( 255 - Sector_Number ) );
(* Transmit Sector Data *)
FOR I := 1 TO Sector_Length DO
Async_Send( CHR( Sector_Data[ I ] ) );
(* Purge receive buffer *)
Async_Purge_Buffer;
(* Increment count of tries to send *)
(* for this sector. *)
Tries := Tries + 1;
(* Pick up a character -- should be ACK *)
Xmodem_Wait_For_Ch( Ch );
(* If CAN, insist on another *)
IF Ch = CAN THEN
Xmodem_Wait_For_Ch( Ch );
IF Ch <> ACK THEN
BEGIN
Display_Send_Error('No ACK', TRUE);
Send_Errors := Send_Errors + 1;
END;
(* Update display *)
Update_Xmodem_Send_Display;
UNTIL ( Ch = ACK ) OR
( Ch = CAN ) OR
( Tries > Max_Tries ) OR
( Stop_Send );
END (* Send_Xmodem_Block *);
(*----------------------------------------------------------------------*)
(* Send_Telink_Header --- send out special block 0 for Telink *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_Telink_Header;
BEGIN (* Send_Telink_Header *)
(* Always send TELINK in Checksum mode *)
Max_Tries := 3;
I := Sector_Length;
Sector_Length := 129;
Header_Ch := CHR( SYN );
Send_Xmodem_Block;
Sector_Length := I;
Max_Tries := 10;
If ( Ch = ACK ) THEN
BEGIN
GoToXY( 26 , 8 );
WRITE('Telink header accepted.');
ClrEol;
END
ELSE
BEGIN
GoToXY( 26 , 8 );
WRITE('Telink header not accepted.');
ClrEol;
END
END (* Send_Telink_Header *);
(*----------------------------------------------------------------------*)
(* Send_Ymodem_Header --- send out special block 0 for Ymodem *)
(*----------------------------------------------------------------------*)
PROCEDURE Send_Ymodem_Header;
BEGIN (* Send_Ymodem_Header *)
(* Always send short block 0 *)
Max_Tries := 3;
I := Sector_Length;
Sector_Length := 130;
Header_Ch := CHR( SOH );
Send_Xmodem_Block;
Sector_Length := I;
Max_Tries := 10;
If ( Ch = ACK ) THEN
BEGIN
GoToXY( 26 , 8 );
WRITE('Ymodem header accepted.');
ClrEol;
END
ELSE
BEGIN
GoToXY( 26 , 8 );
WRITE('Ymodem header not accepted.');
ClrEol;
END
END (* Send_Ymodem_Header *);
(*----------------------------------------------------------------------*)
(* Cancel_Transfer --- Cancel upload *)
(*----------------------------------------------------------------------*)
PROCEDURE Cancel_Transfer;
BEGIN (* Cancel_Transfer *)
(* Purge reception *)
Async_Purge_Buffer;
(* Send five cancels, then five *)
(* backspaces. *)
Async_Send( CHR( CAN ) );
Async_Send( CHR( CAN ) );
Async_Send( CHR( CAN ) );
Async_Send( CHR( CAN ) );
Async_Send( CHR( CAN ) );
Async_Send( CHR( BS ) );
Async_Send( CHR( BS ) );
Async_Send( CHR( BS ) );
Async_Send( CHR( BS ) );
Async_Send( CHR( BS ) );
END (* Cancel_Transfer *);
(*----------------------------------------------------------------------*)
BEGIN (* Send_Xmodem_File *)
(* Open display window for transfer *)
Save_Screen( Saved_Screen );
CASE Transfer_Protocol OF
Xmodem_Chk : Tname := 'Xmodem (Checksum)';
Xmodem_Crc : Tname := 'Xmodem (CRC)';
Telink : Tname := 'Telink';
Modem7_Chk : Tname := 'Modem7 (Checksum)';
Modem7_CRC : Tname := 'Modem7 (CRC)';
Ymodem : Tname := 'Ymodem';
Ymodem_Batch : Tname := 'Ymodem Batch';
END (* CASE *);
Draw_Menu_Frame( 15, 10, 78, 19, Menu_Frame_Color,
Menu_Text_Color,
'Send file ' + FileName + ' using ' + Tname );
(* Headings for status information *)
Window( 16, 11, 77, 18 );
ASSIGN( Xfile_Byte , FileName );
(*$I-*)
RESET ( Xfile_Byte );
(*$I+*)
IF ( Int24Result <> 0 ) THEN
BEGIN
WRITE('Cannot open file to send, transfer cancelled.');
Cancel_Transfer;
DELAY( One_Second_Delay );
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
EXIT;
END;
(* Determine sector size *)
IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
Sector_Size := 1024
ELSE
Sector_Size := 128;
Sector_Size1 := Sector_Size + 1;
Sector_Size2 := Sector_Size + 2;
IF Use_Crc THEN
Sector_Length := Sector_Size2
ELSE
Sector_Length := Sector_Size1;
(* Number of retries of bad block *)
Max_Tries := 20;
(* Figure approx. time for upload *)
Blocks_To_Send := ROUND( ( LongFileSize( Xfile_Byte ) / Sector_Size ) + 0.49 );
Time_To_Send := Blocks_To_Send * ( Sector_Size DIV 128 ) *
( Trans_Time_Val / Baud_Rate );
Time_Per_Blk := Time_To_Send / Blocks_To_Send;
(*$I-*)
CLOSE ( Xfile_Byte );
(*$I+*)
I := Int24Result;
(* Headings for status information *)
WRITELN(' Blocks to send : ', Blocks_To_Send);
WRITELN(' Approx. transfer time : ', TimeString( Time_To_Send ) );
WRITELN(' ');
WRITELN(' Sending block : ');
WRITELN(' Errors : ');
WRITELN(' Time remaining : ', TimeString( Time_To_Send ) );
WRITELN(' ');
WRITE (' Last status message : ');
(* Open file to send *)
I := Open_File_Handle( FileName, Access_Read_Mode, XFile_Handle );
IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
BEGIN
WRITE('Cannot open file to send, transfer cancelled.');
Cancel_Transfer;
DELAY( One_Second_Delay );
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
EXIT;
END;
(* Sector #s start at 1, wrap at 255 *)
Sector_Number := 0;
Sector_Count := 0;
(* No errors yet *)
Send_Errors := 0;
(* Set TRUE if errors halt transfer *)
Stop_Send := FALSE;
(* Starting time for transfer *)
Start_Time := TimeOfDay;
(* Set EOF on Xfile to FALSE *)
EOF_Xfile := FALSE;
(* Set Alt_S encountered off *)
Alt_S_Found := FALSE;
(* No retries yet *)
Tries := 0;
(* Get initial character *)
GoToXY( 26 , 8 );
WRITE('Waiting for NAK/C --- ');
ClrEol;
(* Purge receive buffer *)
Async_Purge_Buffer;
(* Look for NAK or C *)
REPEAT
Xmodem_Wait_For_Ch( Ch );
(* If CAN, insist on another *)
IF Ch = CAN THEN
Xmodem_Wait_For_Ch( Ch );
Tries := Tries + 1;
Check_KeyBoard;
Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
UNTIL ( Tries > Max_Tries ) OR
( Ch = NAK ) OR
( Ch = ORD( 'C' ) ) OR
( Ch = TimeOut ) OR
( Ch = CAN ) OR
Stop_Send;
IF ( Ch = TimeOut ) OR
( Tries > Max_Tries ) OR
( Ch = CAN ) THEN
BEGIN
GoToXY( 26 , 51 );
WRITE('Not Received ');
ClrEol;
Stop_Send := TRUE;
END
ELSE IF ( Ch = NAK ) THEN
Use_Crc := FALSE
ELSE IF ( Ch = ORD( 'C' ) ) THEN
Use_Crc := TRUE;
(* Indicate OK reception *)
IF ( NOT Stop_Send ) THEN
BEGIN
GoToXY( 26 , 51 );
WRITE('Received ');
ClrEol;
(* Set header character *)
IF Transfer_Protocol IN [Ymodem, Ymodem_Batch] THEN
Header_Ch := CHR( STX )
ELSE
Header_Ch := CHR( SOH );
New_Header_Ch := Header_Ch;
(* If Telink or Ymodem, send the *)
(* special initial sector, already *)
(* prepared in Send_Modem7_File or *)
(* Send_Ymodem_File *)
IF Transfer_Protocol = Ymodem_Batch THEN
Send_Ymodem_Header
ELSE IF Transfer_Protocol = Telink THEN
Send_Telink_Header;
END;
(* Begin loop over blocks in file *)
REPEAT
(* See if Alt-S hit, ending transfer *)
Check_Keyboard;
Stop_Send := Stop_Send OR ( NOT Async_Carrier_Detect );
IF ( NOT Stop_Send ) THEN
BEGIN (* Send the next sector *)
(* Set block header character *)
Header_Ch := New_Header_Ch;
(* Read Sector_size chars from file *)
(* to be sent. *)
NRead := Sector_Size;
I := Read_File_Handle( XFile_Handle, Sector_Data, NRead );
(* Check for error *)
IF ( I <> 0 ) OR ( Int24Result <> 0 ) THEN
BEGIN
Display_Send_Error('Cannot read data from file', TRUE);
Stop_Send := TRUE;
END
(* If no chars. read, then EOF *)
ELSE IF NRead <= 0 THEN
EOF_Xfile := TRUE
ELSE
BEGIN (* NOT Eof *)
(* Compute Checksum or Crc *)
IF Use_Crc THEN
BEGIN (* Use CRC *)
Sector_Data[ Sector_Size1 ] := 0;
Sector_Data[ Sector_Size2 ] := 0;
Crc := 0;
FOR I := 1 TO Sector_Size2 DO
Crc := Update_Crc( Crc , Sector_Data[I] );
Sector_Data[ Sector_Size1 ] := HI( Crc );
Sector_Data[ Sector_Size2 ] := LO( Crc );
END (* Use CRC *)
ELSE
BEGIN (* Use Checksum *)
Checksum := 0;
FOR I := 1 TO Sector_Size DO
Checksum := ( Checksum + Sector_Data[ I ] ) MOD 256;
Sector_Data[ Sector_Size1 ] := Checksum;
END (* Use Checksum *);
(* Increment sector number *)
Sector_Number := Sector_Number + 1;
Sector_Count := Sector_Count + 1;
(* Send the block *)
Send_Xmodem_Block;
(* Update transmit time and counts *)
(* of good/bad sectors; also shift *)
(* to 128 byte sectors in Ymodem *)
(* if ratio of bad/good > 1/6. *)
IF Ch = ACK THEN
BEGIN
Time_To_Send := Time_To_Send - Time_Per_Blk;
IF Time_To_Send < 0.0 THEN Time_To_Send := 0.0;
Good_Sectors := Good_Sectors + 1;
END
ELSE
BEGIN
Bad_Sectors := Bad_Sectors + 1;
IF ( Bad_Threshhold * Bad_Sectors > Good_Sectors ) THEN
BEGIN
New_Header_Ch := CHR( SOH );
Sector_Size := 128;
Sector_Size1 := Sector_Size + 1;
Sector_Size2 := Sector_Size + 2;
IF Use_Crc THEN
Sector_Length := Sector_Size2
ELSE
Sector_Length := Sector_Size1;
END;
END;
END (* Not EOF *)
END (* Send Next Sector *);
UNTIL ( EOF_Xfile ) OR ( Tries = Max_Tries ) OR ( Ch = CAN ) OR
( Stop_Send );
(* Send CANs to host to cancel *)
(* transfer *)
IF Stop_Send THEN
IF Async_Carrier_Detect THEN
Cancel_Transfer;
IF Tries >= Max_Tries THEN (* We failed to send a sector correctly *)
Display_Send_Error('No ACK ever received.' , FALSE)
ELSE IF ( Ch = CAN ) THEN (* Receiver cancelled transmission *)
Display_Send_Error('Receiver cancelled transmission.',FALSE)
ELSE IF Alt_S_Found THEN (* User cancelled transmission *)
Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
ELSE IF ( NOT Stop_Send ) THEN (* We sent everything, try sending EOT *)
BEGIN
GoToXY( 26 , 8 );
WRITE('Waiting for ACK of EOT');
ClrEol;
Tries := 0;
REPEAT
Async_Send( CHR( EOT ) );
Tries := Tries + 1;
Xmodem_Wait_For_Ch( Ch );
IF Ch = CAN THEN
Xmodem_Wait_For_Ch( Ch );
Update_Xmodem_Send_Display;
UNTIL ( Ch = ACK ) OR
( Tries = Max_Tries ) OR
( Ch = CAN ) OR
Stop_Send;
IF Tries = Max_Tries THEN
Display_Send_Error('No ACK on EOT (end of transmission)', FALSE)
ELSE IF ( Ch = CAN ) THEN
Display_Send_Error('Receiver cancelled transmission.' , FALSE)
ELSE IF ( Alt_S_Found OR Stop_Send ) THEN
Display_Send_Error('Alt-S key hit, transfer cancelled.',FALSE)
ELSE
BEGIN
GoToXY( 26 , 8 );
WRITE('EOT acknowledged, transfer complete.');
ClrEol;
End_Time := TimeOfDay;
R_Sector_Size := Sector_Size;
IF End_Time > Start_Time THEN
BEGIN
Effective_Rate := ( Blocks_To_Send * R_Sector_Size ) /
( End_Time - Start_Time );
DELAY( One_Second_Delay );
GoToXY( 26 , 8 );
WRITE('Transfer rate was ',Effective_Rate:6:1,' CPS');
ClrEol;
END;
Writelne( ' Sent file ' + FileName, FALSE );
END;
END;
IF Stop_Send THEN
IF Async_Carrier_Drop THEN
Display_Send_Error('Carrier dropped.' , FALSE );
(* Close transferred file *)
I := Close_File_Handle( XFile_Handle );
I := Int24Result;
DELAY( Two_Second_Delay );
(* Remove XMODEM window *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
END (* Send_Xmodem_File *);